home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d13 / obronm10.arc / SCREEN.MOD < prev    next >
Text File  |  1991-02-24  |  3KB  |  116 lines
  1. MODULE Screen ;         (* ERV, 1989 *)
  2.   IMPORT SYS;
  3.  
  4. CONST  minrow * = 0 ;   maxrow * = 24 ;
  5.        mincol * = 0 ;   maxcol * = 79 ;
  6.  
  7. TYPE maptyp = ARRAY maxrow+1, maxcol+1 OF INTEGER ;
  8.      Styp = POINTER TO maptyp ;
  9.  
  10. VAR S : Styp ;  Color * : INTEGER;
  11.     ColorScreen * : BOOLEAN;
  12.  
  13. PROCEDURE SetAddr ;
  14. TYPE ptyp = POINTER TO ARRAY 1 OF SET;
  15. VAR cr:RECORD low, high : INTEGER END;
  16.     p:ptyp;
  17. BEGIN
  18.   cr.low := 10H;  cr.high := 40H; (*equipflag in bios*)
  19.   p := SYS.VAL(ptyp,cr);
  20.   IF (5 IN p^) & (4 IN p^) THEN cr.high := 0B000H (*monochrome screen*);
  21.     ColorScreen := FALSE
  22.   ELSE cr.high := 0B800H (*color screen*); ColorScreen := TRUE
  23.   END;
  24.   cr.low := 0;  S := SYS.VAL(Styp,cr)
  25. END SetAddr;
  26.  
  27.  
  28. PROCEDURE WrtCh * (ch:CHAR; row, col : INTEGER);
  29. BEGIN S[row,col] := 07H * 256 + ORD(ch)
  30. END WrtCh;
  31.  
  32. PROCEDURE WrtStr * (s:ARRAY OF CHAR; row, col : INTEGER);
  33. VAR i,cl:INTEGER;
  34. BEGIN cl := Color * 256;
  35.   i := 0;
  36.   WHILE s[i] # 00X DO S[row,col] := cl + ORD(s[i]);
  37.     INC(i);  INC(col);
  38.     IF col > maxcol THEN INC(row); col := mincol;
  39.        IF row > maxrow THEN row := minrow END
  40.     END
  41.   END
  42. END WrtStr;
  43.  
  44. PROCEDURE WrtHi * (s:ARRAY OF CHAR; row, col : INTEGER);
  45. VAR i:INTEGER;
  46. BEGIN
  47.   i := 0;
  48.   WHILE s[i] # 00X DO S[row,col] := 70H * 256 + ORD(s[i]);
  49.     INC(i);  INC(col);
  50.     IF col > maxcol THEN INC(row); col := mincol;
  51.        IF row > maxrow THEN row := minrow END
  52.     END
  53.   END
  54. END WrtHi;
  55.  
  56. PROCEDURE WrtSp * (VAR s:ARRAY OF BYTE; index,limit:INTEGER; row,col:INTEGER);
  57. VAR ch:CHAR; i,j:INTEGER;  cl:INTEGER;
  58. BEGIN cl := Color * 256;
  59.   ch := CHR(s[index]);  j := limit - index ;
  60.   IF j > maxcol THEN j := maxcol END;
  61.   WHILE (j > 0) & (ch # 0X) DO
  62.     S[row,col] := cl + ORD(ch);
  63.     INC(index);  INC(col);  DEC(j);
  64.     ch := CHR(s[index])
  65.   END ;
  66.   WHILE col < maxcol DO S[row,col] := cl + ORD(" "); INC(col) END
  67. END WrtSp;
  68.  
  69.  
  70. PROCEDURE Clear * ;
  71. VAR cl:INTEGER;
  72. BEGIN cl := Color * 256;
  73. SYS.CODE(
  74.  0B8H, 00H,06H,     (*   mov ax,0600h  ;scroll entire screen down*)
  75.  0B9H, 00H,00H,     (*   mov cx,0            *)
  76.  0BAH, 4FH,18H,     (*   mov dx,(24*256) + 79*)
  77.  8BH, 5EH, 0FCH,    (*   mov bx,[bp-4];get color cl into bh*)
  78.  0CDH, 10H          (*   int 10h             *)
  79.  )
  80. END Clear;
  81.  
  82. PROCEDURE EraseLine * (row:INTEGER);
  83. VAR col,cl:INTEGER;
  84. BEGIN col := mincol;  cl := Color * 256;
  85.   WHILE col < maxcol DO S[row,col] := cl + ORD(" "); INC(col) END
  86. END EraseLine;
  87.  
  88. PROCEDURE SetCursorOn *;
  89. BEGIN SYS.CODE(
  90.  0B4H, 01H,     (*mov ah,1      ;set cursor size *)
  91.  0B9H, 07H,06H, (*mov cx, 0607h ; start/end lines(visible on color)*)
  92.  0CDH, 10H      (*int 10h  *)
  93. )
  94. END SetCursorOn;
  95.  
  96. PROCEDURE SetCursorOff *;
  97. BEGIN SYS.CODE(
  98.  0B4H, 01H,     (*mov ah,1      ;set cursor size *)
  99.  0B9H, 01H,0FH, (*mov cx, 0F01h ; start/end lines(invisible)*)
  100.  0CDH, 10H      (*int 10h  *)
  101.  )
  102. END SetCursorOff;
  103.  
  104. PROCEDURE MoveCursor * (row,col:INTEGER);
  105. BEGIN col := row*256 + col;
  106. SYS.CODE(
  107.  0B4H, 02H,     (* mov ah,2      ;set cursor position                    *)
  108.  8BH, 56H, 06H, (* mov dx,word ptr[bp+6] ; get parm for row/col position *)
  109.  0B7H, 00H,     (* mov bh,0      ;page number                            *)
  110.  0CDH, 10H      (* int 10h                                               *)
  111. )
  112. END MoveCursor;
  113.  
  114. BEGIN SetAddr;  Color := 07H
  115. END Screen.
  116.